module file_io

    use message
    use run_manager
    use string
    use hdf5

    implicit none

    private

    public file_io_init
    public file_io_create_input_file
    public file_io_create_output_file
    public file_io_create_data_folder
    public file_io_create_data_card
    public file_io_input
    public file_io_output
    public file_io_finalize

    type data_card
        character(10) :: name
        integer(HID_T) :: id
        integer(HID_T) :: type_id
        integer(HID_T) :: cur_data_id
        integer(HID_T) :: cur_dims_id
        type(data_card), pointer :: prev
        type(data_card), pointer :: next
    end type data_card

    type data_folder
        character(20) :: name
        integer(HID_T) :: id
        integer :: num_card
        type(data_card), pointer :: data_card_entry
        type(data_folder), pointer :: prev
        type(data_folder), pointer :: next
    end type data_folder

    type data_file
        character(100) :: name
        integer(HID_T) :: id
        integer :: num_folder
        type(data_folder), pointer :: data_folder_entry
        type(data_file), pointer :: prev
        type(data_file), pointer :: next
    end type data_file

    integer :: num_input_file
    type(data_file), pointer :: input_file_entry

    integer :: num_output_file
    type(data_file), pointer :: output_file_entry

    logical :: initialized = .false.

contains
!================================================================
!================================================================
!================================================================
    subroutine file_io_init
        integer :: error

        if(initialized) return

        num_input_file = 0
        num_output_file = 0

        call h5open_f(error)
        call watch("file_io_init", error)

        call run_manager_register_end("file_io", &
            "file_io_finalize", file_io_finalize)

        initialized = .true.

        return
    end subroutine file_io_init
!================================================================
!================================================================
!================================================================
    subroutine file_io_create_input_file(file_name)
        character(*), intent(in) :: file_name

        character(100) :: msg
        logical :: alive
        type(data_file), pointer :: fp1, fp2
        type(data_folder), pointer :: dfp1, dfp2
        type(data_card), pointer :: dcp1, dcp2
        integer :: i, j, n, error
        character(20) :: obj_name
        integer :: obj_type

        ! check file existence
        inquire(file=file_name, exist=alive)
        if(alive == .false.) then
            msg = "Input file """// &
                trim(file_name)  // &
                """ does not exist"
            call message_show(ERROR_MSG, &
                "file_io", "file_io_create_input_file", msg)
            call run_manager_end_run
        end if

        if(.not. associated(input_file_entry)) then
            ! create new input file
            allocate(input_file_entry)
            fp1 => input_file_entry
            nullify(fp1%prev)
        else
            fp1 => input_file_entry
            do i = 1, num_input_file
                ! if input data file has been created, return
                if(file_name == fp1%name) then
                    return
                end if
                if(i /= num_input_file) fp1 => fp1%next
            end do
            allocate(fp1%next)
            fp2 => fp1
            fp1 => fp1%next
            fp1%prev => fp2
        end if

        ! setup input data file
        num_input_file = num_input_file+1
        fp1%name = file_name
        fp1%num_folder = 0
        nullify(fp1%data_folder_entry)

        ! open input data file
        call h5fopen_f(file_name, H5F_ACC_RDONLY_F, &
            fp1%id, error)
        call watch("file_io_create_input_file", error)

        ! get information from input data file
        ! how many data folders?
        call h5gn_members_f(fp1%id, "/", fp1%num_folder, error)
        call watch("file_io_create_input_file", error)
        
        ! setup data folder
        do i = 1, fp1%num_folder
            call h5gget_obj_info_idx_f(fp1%id, "/", i-1, &
                obj_name, obj_type, error)
            call watch("file_io_create_input_file", error)
            if(obj_type == H5G_GROUP_F) then
                if(.not. associated(fp1%data_folder_entry)) then
                    allocate(fp1%data_folder_entry)
                    dfp1 => fp1%data_folder_entry
                    nullify(dfp1%prev)
                end if
                dfp1%name = obj_name
                dfp1%num_card = 0
                if(i /= fp1%num_folder) then
                    allocate(dfp1%next)
                    dfp2 => dfp1
                    dfp1 => dfp1%next
                    dfp1%prev => dfp2
                else
                    nullify(dfp1%next)
                end if
            end if
        end do
        if(.not. associated(fp1%data_folder_entry)) then
            call message_show(ERROR_MSG,                &
                "file_io", "file_io_create_input_file", &
                "There is no data folder in file """    &
                // trim(file_name) // """")
            call run_manager_end_run
        end if

        ! get information about data card from data folder
        ! and setup data card
        dfp1 => fp1%data_folder_entry
        do i = 1, fp1%num_folder
            call h5gopen_f(fp1%id, dfp1%name, dfp1%id, error)
            call watch("file_io_create_input_file", error)
            call h5gn_members_f(fp1%id, dfp1%name, &
                dfp1%num_card, error)
            call watch("file_io_create_input_file", error)
            do j = 1, dfp1%num_card
                call h5gget_obj_info_idx_f(fp1%id, dfp1%name, &
                    j-1, obj_name, obj_type, error)
                call watch("file_io_create_input_file", error)
                if(obj_type == H5G_GROUP_F) then
                    if(.not. associated(dfp1%data_card_entry)) then
                        allocate(dfp1%data_card_entry)
                        dcp1 => dfp1%data_card_entry
                        nullify(dcp1%prev)
                    end if
                    dcp1%name = obj_name
                    if(j /= dfp1%num_card) then
                        allocate(dcp1%next)
                        dcp2 => dcp1
                        dcp1 => dcp1%next
                        dcp1%prev => dcp2
                    else
                        nullify(dcp1%next)
                    end if
                end if
            end do
        end do

        ! open data card
        dfp1 => fp1%data_folder_entry
        do i = 1, fp1%num_folder
            if(.not. associated(dfp1%data_card_entry)) then
                call message_show(ERROR_MSG,                &
                    "file_io", "file_io_create_input_file", &
                    "There is no data card in file """      &
                    // trim(file_name) // """::"""          &
                    // trim(dfp1%name) // """")
                call run_manager_end_run
            end if
            dcp1 => dfp1%data_card_entry
            do j = 1, dfp1%num_card
                call h5gopen_f(dfp1%id, dcp1%name, dcp1%id, error)
                call watch("file_io_create_input_file", error)
                ! check initial dataset
                call h5gn_members_f(dfp1%id, dcp1%name, n, error)
                call watch("file_io_create_input_file", error)
                if(n /= 1) then
                    call message_show(ERROR_MSG,                &
                        "file_io", "file_io_create_input_file", &
                        "There are more than one data set "     &
                        // "in file """ // trim(file_name)      &
                        // """")
                    call run_manager_end_run
                end if
                call h5gget_obj_info_idx_f(dfp1%id, dcp1%name, &
                    0, obj_name, obj_type, error)
                if(obj_type == H5G_DATASET_F) then
                    call h5dopen_f(dcp1%id, obj_name, &
                        dcp1%cur_data_id, error)
                    call watch("file_io_create_input_file", error)
                    call h5dget_type_f(dcp1%cur_data_id, &
                        dcp1%type_id, error)
                    call watch("file_io_create_input_file", error)
                    call h5dget_space_f(dcp1%cur_data_id, &
                        dcp1%cur_dims_id, error)
                    call watch("file_io_create_input_file", error)
                else
                    msg = "No dataset found in """   &
                        // trim(file_name) // """::""" &
                        // trim(dfp1%name) // """"
                    call message_show(ERROR_MSG, &
                        "file_io", "file_io_create_input_file", msg)
                    call run_manager_end_run
                end if
                dcp1 => dcp1%next
            end do
            dfp1 => dfp1%next
        end do

        return
    end subroutine file_io_create_input_file
!================================================================
!================================================================
!================================================================
    subroutine file_io_create_output_file(file_name)
        character(*), intent(in) :: file_name

        type(data_file), pointer :: fp1, fp2
        integer :: i, error

        if(.not. associated(output_file_entry)) then
            ! create new file
            allocate(output_file_entry)
            fp1 => output_file_entry
            nullify(fp1%prev)
        else
            ! check file repeat
            fp1 => output_file_entry
            do i = 1, num_output_file
                if(file_name == fp1%name) then
                    return
                end if
                if(i /= num_output_file) fp1 => fp1%next
            end do
            ! create new file
            allocate(fp1%next)
            fp2 => fp1
            fp1 => fp1%next
            fp1%prev => fp2
        end if

        num_output_file = num_output_file+1
        fp1%name = file_name
        nullify(fp1%next)
        fp1%num_folder = 0
        nullify(fp1%data_folder_entry)
        
        call h5fcreate_f(file_name, H5F_ACC_TRUNC_F, fp1%id, error)
        call watch("file_io_create_output_file", error)

        return
    end subroutine file_io_create_output_file
!================================================================
!================================================================
!================================================================
    subroutine file_io_create_data_folder(file_name, folder_name)
        character(*), intent(in) :: file_name
        character(*), intent(in) :: folder_name

        type(data_file), pointer :: fp
        type(data_folder), pointer :: dfp1, dfp2
        character(100) :: msg
        integer(HID_T) :: temp_id
        integer :: i, error

        if(.not. associated(output_file_entry)) then
            call message_show(ERROR_MSG, &
                "file_io", "file_io_create_data_folder", &
                "output file has not been created")
            call run_manager_end_run
        end if

        fp => output_file_entry
        do i = 1, num_output_file
            if(fp%name == file_name) exit
            fp => fp%next
        end do

        ! file not created error
        if(.not. associated(fp)) then
            msg = "file """ // trim(file_name) &
                // """ does not exist"
            call message_show(ERROR_MSG, &
                "file_io", "file_io_create_data_folder", msg)
            call run_manager_end_run
        end if

        if(.not. associated(fp%data_folder_entry)) then
            ! create new data folder
            allocate(fp%data_folder_entry)
            dfp1 => fp%data_folder_entry
            nullify(dfp1%prev)
        else
            ! check data folder repeat
            dfp1 => fp%data_folder_entry
            do i = 1, fp%num_folder
                if(dfp1%name == folder_name) return
                if(i /= fp%num_folder) dfp1 => dfp1%next
            end do
            ! create new data folder
            allocate(dfp1%next)
            dfp2 => dfp1
            dfp1 => dfp1%next
            dfp1%prev => dfp2
        end if

        fp%num_folder = fp%num_folder+1
        dfp1%name = folder_name
        dfp1%num_card = 0
        nullify(dfp1%data_card_entry)
        nullify(dfp1%next)

        call h5gcreate_f(fp%id, folder_name, dfp1%id, error)
        call watch("file_io_create_data_folder", error)

        return
    end subroutine file_io_create_data_folder
!================================================================
!================================================================
!================================================================
    subroutine file_io_create_data_card(file_name, folder_name, &
        card_name)

        character(*), intent(in) :: file_name
        character(*), intent(in) :: folder_name
        character(*), intent(in) :: card_name

        type(data_file), pointer :: fp
        type(data_folder), pointer :: dfp
        type(data_card), pointer :: dcp1, dcp2
        character(100) :: msg, str
        real :: test
        integer(HID_T) :: temp_id
        integer :: i, error

        if(.not. associated(output_file_entry)) then
            call message_show(ERROR_MSG, &
                "file_io", "file_io_create_data_card", &
                "output file has not been created")
            call run_manager_end_run
        end if

        fp => output_file_entry
        do i = 1, num_output_file
            if(fp%name == file_name) exit
            fp => fp%next
        end do

        if(.not. associated(fp)) then
            msg = "file """ // trim(file_name) &
                // """ does not exist"
            call message_show(ERROR_MSG, &
                "file_io", "file_io_create_data_card", msg)
            call run_manager_end_run
        end if

        if(.not. associated(fp%data_folder_entry)) then
            msg = "data folder in file """ // trim(file_name) &
                // """ has not been created"
            call message_show(ERROR_MSG, &
                "file_io", "file_io_create_data_card", msg)
            call run_manager_end_run
        end if

        dfp => fp%data_folder_entry
        do i = 1, fp%num_folder
            if(dfp%name == folder_name) exit
            dfp => dfp%next
        end do

        if(.not. associated(dfp)) then
            msg = "data folder """ // trim(folder_name) &
                // """ in file """ // trim(file_name)   &
                // """ does not exist"
            call message_show(ERROR_MSG, &
                "file_io", "file_io_create_data_card", msg)
            call run_manager_end_run
        end if

        if(.not. associated(dfp%data_card_entry)) then
            ! create new data card
            allocate(dfp%data_card_entry)
            dcp1 => dfp%data_card_entry
            nullify(dcp1%prev)
        else
            ! check data card repeat
            dcp1 => dfp%data_card_entry
            do i = 1, dfp%num_card
                if(dcp1%name == card_name) return
                if(i /= dfp%num_card) dcp1 => dcp1%next
            end do
            ! create new data card
            allocate(dcp1%next)
            dcp2 => dcp1
            dcp1 => dcp1%next
            dcp1%prev => dcp2
        end if

        dfp%num_card = dfp%num_card+1
        dcp1%name = card_name
        nullify(dcp1%next)

        ! setup data type
        i = sizeof(test)
        if(i == 4) then ! single precision
            call h5tcopy_f(H5T_NATIVE_REAL, dcp1%type_id, error)
            call watch("file_io_create_data_card", error)
        else if(i == 8) then ! double precision
            call h5tcopy_f(H5T_NATIVE_DOUBLE, dcp1%type_id, error)
            call watch("file_io_create_data_card", error)
        else
            call string_from_integer(i, str)
            write(msg, "(3a)")                   &
                "Unsupported data type with """, &
                str, """ bytes"
            call message_show(ERROR_MSG, &
                "file_io", "file_io_create_data_card", msg)
            call run_manager_end_run
        end if

        call h5gcreate_f(dfp%id, card_name, dcp1%id, error)
        call watch("file_io_create_data_card", error)

        return
    end subroutine file_io_create_data_card
!================================================================
!================================================================
!================================================================
    subroutine file_io_input(file_name, folder_name, card_name, &
        buf, nd, dims)

        character(*), intent(in) :: file_name
        character(*), intent(in) :: folder_name
        character(*), intent(in) :: card_name
        real, intent(out) :: buf(*)
        integer, intent(in) :: nd
        integer, intent(in) :: dims(*)

        type(data_file), pointer :: fp
        type(data_folder), pointer :: dfp
        type(data_card), pointer :: dcp
        integer(HSIZE_T) :: dims_h5(nd)
        character(100) :: msg
        integer :: i, error

        if(.not. associated(input_file_entry)) then
            call message_show(ERROR_MSG, &
                "file_io", "file_io_input", &
                "input file has not been created")
            call run_manager_end_run
        end if

        fp => input_file_entry
        do i = 1, num_input_file
            if(fp%name == file_name) exit
            if(i /= num_input_file) fp => fp%next
        end do

        if(.not. associated(fp)) then
            msg = "file """ // trim(file_name) &
                // """ does not exist"
            call message_show(ERROR_MSG, &
                "file_io", "file_io_input", msg)
            call run_manager_end_run
        end if

        if(.not. associated(fp%data_folder_entry)) then
            msg = "data folder in """ // trim(file_name) &
                // """ does not exist"
            call message_show(ERROR_MSG, &
                "file_io", "file_io_input", msg)
            call run_manager_end_run
        end if

        dfp => fp%data_folder_entry
        do i = 1, fp%num_folder
            if(dfp%name == folder_name) exit
            if(i /= fp%num_folder) dfp => dfp%next
        end do

        if(.not. associated(dfp)) then
            msg = "data folder """ // trim(folder_name) &
                // """ in """ // trim(file_name)        &
                // """ does not exist"
            call message_show(ERROR_MSG, &
                "file_io", "file_io_input", msg)
            call run_manager_end_run
        end if

        if(.not. associated(dfp%data_card_entry)) then
            msg = "data card in file """ // trim(file_name)   &
                // """ and in folder """ // trim(folder_name) &
                // """ does not exist"
            call message_show(ERROR_MSG, &
                "file_io", "file_io_input", msg)
            call run_manager_end_run
        end if

        dcp => dfp%data_card_entry
        do i = 1, dfp%num_card
            if(dcp%name == card_name) exit
            if(i /= dfp%num_card) dcp => dcp%next
        end do

        if(.not. associated(dcp)) then
            msg = "data card """         // trim(card_name)   &
                // """ in """ // trim(file_name) // """::"""  &
                // trim(folder_name) // """ does not exist"
            call message_show(ERROR_MSG, &
                "file_io", "file_io_input", msg)
            call run_manager_end_run
        end if

        dims_h5 = dims(1:nd)
        call h5dread_f(dcp%cur_data_id, dcp%type_id, buf, &
            dims_h5, error)
        call watch("file_io_input", error)

        return
    end subroutine file_io_input
!================================================================
!================================================================
!================================================================
    subroutine file_io_output(label, file_name, folder_name, &
        card_name, buf, nd, dims)

        character(*), intent(in) :: label
        character(*), intent(in) :: file_name
        character(*), intent(in) :: folder_name
        character(*), intent(in) :: card_name
        real, intent(in) :: buf(*)
        integer, intent(in) :: nd
        integer, intent(in) :: dims(*)

        type(data_file), pointer :: fp
        type(data_folder), pointer :: dfp
        type(data_card), pointer :: dcp
        integer(HSIZE_T) :: dims_h5(nd)
        character(100) :: msg
        integer :: i, error

        if(.not. associated(output_file_entry)) then
            call message_show(ERROR_MSG, &
                "file_io", "file_io_output", &
                "output file has not been created")
            call run_manager_end_run
        end if

        fp => output_file_entry
        do i = 1, num_output_file
            if(fp%name == file_name) exit
            if(i /= num_output_file) fp => fp%next
        end do

        if(.not. associated(fp)) then
            msg = "file """ // trim(file_name) &
                // """ does not exist"
            call message_show(ERROR_MSG, &
                "file_io", "file_io_output", msg)
            call run_manager_end_run
        end if

        if(.not. associated(fp%data_folder_entry)) then
            msg = "data folder in """ // trim(file_name) &
                // """ has not been created"
            call message_show(ERROR_MSG, &
                "file_io", "file_io_output", msg)
            call run_manager_end_run
        end if

        dfp => fp%data_folder_entry
        do i = 1, fp%num_folder
            if(dfp%name == folder_name) exit
            if(i /= fp%num_folder) dfp => dfp%next
        end do

        if(.not. associated(dfp)) then
            msg = "data folder """ // trim(folder_name) &
                // """ in """ // trim(file_name)        &
                // """ does not exist"
            call message_show(ERROR_MSG, &
                "file_io", "file_io_output", msg)
            call run_manager_end_run
        end if

        if(.not. associated(dfp%data_card_entry)) then
            msg = "data card in """ // trim(file_name) &
                // """::""" // trim(folder_name)       &
                // """ has not been created"
            call message_show(ERROR_MSG, &
                "file_io", "file_io_output", msg)
            call run_manager_end_run
        end if

        dcp => dfp%data_card_entry
        do i = 1, dfp%num_card
            if(dcp%name == card_name) exit
            if(i /= dfp%num_card) dcp => dcp%next
        end do

        if(.not. associated(dcp)) then
            msg = "data card """         // trim(card_name)  &
                // """ in """ // trim(file_name) // """::""" &
                // trim(folder_name) // """ does not exist"
            call message_show(ERROR_MSG, &
                "file_io", "file_io_output", msg)
            call run_manager_end_run
        end if

        ! setup data dimensions
        dims_h5 = dims(1:nd)
        call h5screate_simple_f(nd, dims_h5, dcp%cur_dims_id, error)
        call watch("file_io_output", error)

        ! setup data
        call h5dcreate_f(dcp%id, label, dcp%type_id, &
            dcp%cur_dims_id, dcp%cur_data_id, error)
        call watch("file_io_output", error)

        ! write data
        call h5dwrite_f(dcp%cur_data_id, dcp%type_id, &
            buf, dims_h5, error)
        call watch("file_io_output", error)

        return
    end subroutine file_io_output
!================================================================
!================================================================
!================================================================
    subroutine file_io_finalize
        integer :: error

        type(data_file), pointer :: fp
        type(data_folder), pointer :: dfp
        type(data_card), pointer :: dcp
        integer :: i, j, k

        fp => input_file_entry
        do i = 1, num_input_file
            dfp => fp%data_folder_entry
            do j = 1, fp%num_folder
                dcp => dfp%data_card_entry
                do k = 1, dfp%num_card
                    call h5tclose_f(dcp%type_id, error)
                    call watch("file_io_finalize", error)
                    call h5sclose_f(dcp%cur_dims_id, error)
                    call watch("file_io_finalize", error)
                    call h5dclose_f(dcp%cur_data_id, error)
                    call watch("file_io_finalize", error)
                    call h5gclose_f(dcp%id, error)
                    call watch("file_io_finalize", error)
                    dcp => dcp%next
                end do
                call h5gclose_f(dfp%id, error)
                call watch("file_io_finalize", error)
                dfp => dfp%next
            end do
            call h5fclose_f(fp%id, error)
            call watch("file_io_finalize", error)
            fp => fp%next
        end do

        fp => output_file_entry
        do i = 1, num_output_file
            dfp => fp%data_folder_entry
            do j = 1, fp%num_folder
                dcp => dfp%data_card_entry
                do k = 1, dfp%num_card
                    call h5tclose_f(dcp%type_id, error)
                    call watch("file_io_finalize", error)
                    call h5sclose_f(dcp%cur_dims_id, error)
                    call watch("file_io_finalize", error)
                    call h5dclose_f(dcp%cur_data_id, error)
                    call watch("file_io_finalize", error)
                    call h5gclose_f(dcp%id, error)
                    call watch("file_io_finalize", error)
                    dcp => dcp%next
                end do
                call h5gclose_f(dfp%id, error)
                call watch("file_io_finalize", error)
                dfp => dfp%next
            end do
            call h5fclose_f(fp%id, error)
            call watch("file_io_finalize", error)
            fp => fp%next
        end do

        call h5close_f(error)
        call watch("file_io_finalize", error)

        return
    end subroutine file_io_finalize
!================================================================
!================================================================
!================================================================
    subroutine watch(sub_name, errno)
        character(*), intent(in) :: sub_name
        integer, intent(in) :: errno

        character(100) :: msg, str
        integer :: error

        if(errno < 0 ) then
            call message_show(ERROR_MSG, &
                "file_io", trim(sub_name), "HDF5 internal error")
            call run_manager_end_run
        end if

        return
    end subroutine watch
!================================================================
!================================================================
!================================================================
end module file_io
